home *** CD-ROM | disk | FTP | other *** search
Oberon Text | 1995-06-30 | 21.2 KB | 493 lines | [TEXT/.Ob4] |
- Syntax10.Scn.Fnt
- Syntax10i.Scn.Fnt
- StampElems
- Alloc
- 8 May 95
- Syntax10b.Scn.Fnt
- MODULE Dialog;
- (** extended version by Markus Knasm
- ller 25.May.94 -
- IMPORT DialogFrames, Dialogs, DialogButtons, Display, Display1, Files, In, Input, MenuViewers,
- TextFrames, Texts, Oberon, Printer, Viewers;
- (* DialogText must be loaded before, because setting of o.Edit and o.Update must be before Editing is possible *)
- CONST
- ML =2; MM = 1; MR = 0; CRSU = 0C1X; CRSD = 0C2X; CRSR = 0C3X; CRSL = 0C4X; CR = 0DX;
- editMenu = "System.Close System.Copy System.Grow Dialog.Store ";
- markW = 5;
- VAR
- reticule*:Oberon.Marker; (** used as caret *)
- w0: Texts.Writer;
- DW, DH, CL: INTEGER;
- nx, ny, X1, X0, Y1, Y0: INTEGER;
- editObjectX, editObjectY: INTEGER;
- PROCEDURE Min (x: INTEGER; y:INTEGER): INTEGER;
- BEGIN IF x < y THEN RETURN x ELSE RETURN y END
- END Min;
- PROCEDURE Open*; (** name | ^ *)
- (** opens a dialog viewer and displays the dialog from file name *)
- VAR x, y, res: INTEGER; p: Dialogs.Panel; name: ARRAY 64 OF CHAR;
- BEGIN
- In.Open; In.Name (name);
- IF In.Done THEN
- Oberon.AllocateSystemViewer (Oberon.Mouse.X, x, y);
- DialogFrames.OpenPanel (name, x, y, p)
- END
- END Open;
- PROCEDURE SetInitCmd*; (** cmd | ^ *)
- (** sets the command of the marked dialog to cmd *)
- VAR x, y: INTEGER; p: Dialogs.Panel; cmd: ARRAY 64 OF CHAR;
- BEGIN
- In.Open; In.Name (cmd);
- IF In.Done THEN Dialogs.res := Dialogs.ok ELSE Dialogs.res := Dialogs.wrongInput END;
- IF Dialogs.res = Dialogs.ok THEN
- DialogFrames.GetCaretPosition (p, x, y);
- IF p # NIL THEN p.SetCmd (cmd) ELSE Dialogs.res := Dialogs.noPanelSelected END
- END;
- IF Dialogs.res # Dialogs.ok THEN Dialogs.Error ("Dialog") END
- END SetInitCmd;
- PROCEDURE SetName*; (** name | ^ *)
- (** sets the name of the object under the caret to name *)
- VAR o: Dialogs.Object; p: Dialogs.Panel; name: ARRAY 16 OF CHAR;
- BEGIN
- In.Open; In.Name (name);
- IF In.Done THEN Dialogs.res := Dialogs.ok
- ELSE In.Open; In.String (name); IF In.Done THEN Dialogs.res := Dialogs.ok ELSE Dialogs.res := Dialogs.wrongInput END
- END;
- IF Dialogs.res = Dialogs.ok THEN
- DialogFrames.FindObject (o, p);
- IF Dialogs.res = Dialogs.ok THEN o.SetName (name) END
- END;
- IF Dialogs.res # Dialogs.ok THEN Dialogs.Error ("Dialog") END
- END SetName;
- PROCEDURE SetCmd*; (** cmd | ^ *)
- (** sets the command of the object under the caret to cmd *)
- VAR o: Dialogs.Object; p: Dialogs.Panel; cmd: ARRAY 32 OF CHAR;
- BEGIN
- In.Open; In.Name (cmd);
- IF In.Done THEN Dialogs.res := Dialogs.ok ELSE Dialogs.res := Dialogs.wrongInput END;
- IF Dialogs.res = Dialogs.ok THEN
- DialogFrames.FindObject (o, p);
- IF Dialogs.res = Dialogs.ok THEN o.SetCmd (cmd) END
- END;
- IF Dialogs.res # Dialogs.ok THEN Dialogs.Error ("Dialog") END
- END SetCmd;
- PROCEDURE SetPar*; (** par | ^ *)
- (** sets the parameter of the item at the caret to par. par is from type {ch} *)
- VAR o: Dialogs.Object; p: Dialogs.Panel; par: ARRAY 32 OF CHAR; ch: CHAR; i: INTEGER;
- BEGIN
- In.Open; In.Char (ch); i := 0;
- WHILE In.Done & (ch = " ") DO In.Char (ch) END; (* skip leading blanks *)
- IF ~ In.Done THEN
- Dialogs.res := Dialogs.wrongInput
- ELSE
- Dialogs.res := Dialogs.ok;
- WHILE In.Done & (ch # CR) & (ch # "~") & (i < 31) DO par[i] := ch; INC (i); In.Char (ch) END;
- par[i] := 0X;
- END;
- IF Dialogs.res = Dialogs.ok THEN
- DialogFrames.FindObject (o, p);
- IF Dialogs.res = Dialogs.ok THEN o.SetPar (par) END
- END;
- IF Dialogs.res # Dialogs.ok THEN Dialogs.Error ("Dialog") END
- END SetPar;
- PROCEDURE SetDim*; (** x y w h | ^ *)
- (** sets the lower left coordinates of the object under the caret to x and y, the width to w and the height to h *)
- VAR x, y, w, h, x1, y1: INTEGER; o: Dialogs.Object; p: Dialogs.Panel; v: Viewers.Viewer;
- BEGIN
- In.Open; In.Int (x); Dialogs.res := Dialogs.ok;
- IF ~ In.Done THEN Dialogs.res := Dialogs.wrongInput END;
- In.Int (y); IF ~ In.Done THEN Dialogs.res := Dialogs.wrongInput END;
- In.Int (w); IF ~ In.Done THEN Dialogs.res := Dialogs.wrongInput END;
- In.Int (h); IF ~ In.Done THEN Dialogs.res := Dialogs.wrongInput END;
- DialogFrames.GetCaretPosition (p, x1, y1);
- v := Viewers.This (x1, y1);
- IF (v = NIL) OR (x > v.W) OR (ABS (y) > v.H) THEN Dialogs.res := Dialogs.wrongInput END;
- IF Dialogs.res = Dialogs.ok THEN
- DialogFrames.FindObject (o, p);
- IF Dialogs.res = Dialogs.ok THEN o.SetDim (x, y, w, h, FALSE) END
- END;
- IF Dialogs.res # Dialogs.ok THEN Dialogs.Error ("Dialog") END
- END SetDim;
- PROCEDURE AlignSelected*; (** dir | ^ *)
- (** aligns the selected objects so that they have the same left, right, top or bottom coordinates *)
- VAR dir: CHAR; x, y: INTEGER; p: Dialogs.Panel; name: ARRAY 64 OF CHAR;
- BEGIN
- In.Open; In.Name (name); Dialogs.res := Dialogs.ok;
- IF In.Done THEN dir := name[0] END;
- IF (dir # "R") & (dir # "L") & (dir # "U") & (dir # "D") THEN
- Dialogs.res := Dialogs.wrongInput
- ELSE
- DialogFrames.GetCaretPosition (p, x, y);
- IF p # NIL THEN
- p.AlignSelected (dir)
- ELSE
- Dialogs.res := Dialogs.noPanelSelected
- END
- END;
- IF Dialogs.res # Dialogs.ok THEN Dialogs.Error ("Dialog") END
- END AlignSelected;
- PROCEDURE RegulateDistance*; (** dir | ^ *)
- (** regulates the distance between the selected objects *)
- VAR dir: CHAR; i, j: INTEGER; p: Dialogs.Panel; name: ARRAY 64 OF CHAR;
- BEGIN
- In.Open; In.Name (name); Dialogs.res := Dialogs.ok;
- IF In.Done THEN dir := name [0] END;
- IF (dir # "R") & (dir #"L") & (dir # "U") & (dir # "D")
- THEN Dialogs.res := Dialogs.wrongInput
- ELSE
- DialogFrames.GetCaretPosition (p, i, j);
- IF p # NIL THEN
- p.RegulateDistance (dir)
- ELSE
- Dialogs.res := Dialogs.noPanelSelected
- END
- END;
- IF Dialogs.res # Dialogs.ok THEN Dialogs.Error ("Dialog") END
- END RegulateDistance;
- PROCEDURE GetDim*;
- (** writes the coordinates of the lower left corner, the width and the height
- of the object under the caret to the log viewer *)
- VAR x, y, w, h: INTEGER; o: Dialogs.Object; p: Dialogs.Panel;
- BEGIN
- DialogFrames.FindObject (o, p);
- IF Dialogs.res = Dialogs.ok THEN
- o.GetDim (x, y, w, h);
- Texts.WriteString (w0, "Coor: "); Texts.WriteInt (w0, x, 5); Texts.WriteInt (w0, y, 5);
- Texts.WriteLn (w0); Texts.WriteString (w0, "Wide and Height: "); Texts.WriteInt (w0, w, 5);
- Texts.WriteInt (w0, h, 5); Texts.WriteLn (w0); Texts.Append (Oberon.Log, w0.buf)
- ELSE
- Dialogs.Error ("Dialog")
- END
- END GetDim;
- PROCEDURE GetName*;
- (** writes the name of the object under the caret to the log viewer *)
- VAR o: Dialogs.Object; p: Dialogs.Panel; name: ARRAY 32 OF CHAR;
- BEGIN
- DialogFrames.FindObject (o, p);
- IF Dialogs.res = Dialogs.ok THEN
- COPY (o.name, name); Texts.WriteString (w0, "Name: "); Texts.WriteString (w0, name);
- Texts.WriteLn (w0); Texts.Append (Oberon.Log, w0.buf)
- ELSE
- Dialogs.Error ("Dialog")
- END
- END GetName;
- PROCEDURE GetCmd*;
- (** writes the command of the object under the caret to the log viewer *)
- VAR o: Dialogs.Object; p: Dialogs.Panel; cmd: ARRAY 64 OF CHAR;
- BEGIN
- DialogFrames.FindObject (o, p);
- IF Dialogs.res = Dialogs.ok THEN
- COPY (o.cmd, cmd); Texts.WriteString (w0, "Command: "); Texts.WriteString (w0, cmd);
- Texts.WriteLn (w0); Texts.Append (Oberon.Log, w0.buf)
- ELSE
- Dialogs.Error ("Dialog")
- END
- END GetCmd;
- PROCEDURE GetInitCmd*;
- (** writes the command of the marked dialog to the log viewer *)
- VAR x, y: INTEGER; p: Dialogs.Panel; cmd: ARRAY 64 OF CHAR;
- BEGIN
- DialogFrames.GetCaretPosition (p, x, y); Dialogs.res := Dialogs.ok;
- IF p # NIL THEN
- COPY (p.cmd, cmd); Texts.WriteString (w0, "Command: "); Texts.WriteString (w0, cmd);
- Texts.WriteLn (w0); Texts.Append (Oberon.Log, w0.buf)
- ELSE
- Dialogs.res := Dialogs.noPanelSelected
- END;
- IF Dialogs.res # Dialogs.ok THEN Dialogs.Error ("Dialog") END
- END GetInitCmd;
- PROCEDURE GetPar*;
- (** writes the component par of the item under the caret to the log viewer *)
- VAR o: Dialogs.Object; p: Dialogs.Panel; par: ARRAY 64 OF CHAR;
- BEGIN
- DialogFrames.FindObject (o, p);
- IF Dialogs.res = Dialogs.ok THEN
- COPY (o.par, par); Texts.WriteString (w0, "Parameter: "); Texts.WriteString (w0, par);
- Texts.WriteLn (w0); Texts.Append (Oberon.Log, w0.buf)
- ELSE
- Dialogs.Error ("Dialog")
- END
- END GetPar;
- PROCEDURE SetGrid*; (** int | ^ *)
- (** sets the grid to which mouse movements are restricted *)
- VAR i: INTEGER; f: DialogFrames.Frame; v: Viewers.Viewer;
- BEGIN
- v := Oberon.MarkedViewer();
- IF v.dsc.next IS DialogFrames.Frame THEN
- f := v.dsc.next(DialogFrames.Frame);
- In.Open; In.Int(i);
- IF (In.Done) & (i <= DialogFrames.gridMax) & (i >= DialogFrames.gridMin) THEN
- f.grid := i; Dialogs.res := Dialogs.ok
- ELSE
- Dialogs.res := Dialogs.wrongInput; Dialogs.Error ("Dialog")
- END
- END
- END SetGrid;
- PROCEDURE box (o: Dialogs.Object; VAR done: BOOLEAN);
- VAR x, y, w, h: INTEGER;
- BEGIN
- IF ~o.selected THEN RETURN END;
- o.GetDim (x, y, w, h); y := ABS (y);
- IF x < X0 THEN X0 := x END;
- IF X1 < x + w THEN X1 := x + w END;
- IF y - h < Y0 THEN Y0 := y - h END;
- IF Y1 < y THEN Y1 := y END
- END box;
- PROCEDURE EnumCopy (o: Dialogs.Object; VAR done: BOOLEAN);
- VAR x, y, w, h: INTEGER; new: Dialogs.Object;
- BEGIN
- IF ~o.selected THEN RETURN END;
- new := NIL; o.Copy (new); new.SetName ("");
- o.GetDim (x, y, w, h); new.SetDim (x + nx, y + ny, w, h, new.overlapping);
- o.panel.Insert (new, new.overlapping);
- END EnumCopy;
- PROCEDURE Do*;
- VAR o: Dialogs.Object; v: Viewers.Viewer; t: Texts.Text; r: Texts.Reader; ch: CHAR;
- BEGIN
- o := Dialogs.editObject; v := Oberon.Par.vwr;
- IF o # NIL THEN o.Update (Dialogs.cmdPanel) END;
- t := v.dsc (TextFrames.Frame).text;
- Texts.OpenReader (r, t, t.len - 1); Texts.Read (r, ch);
- IF (ch = "!") & (Dialogs.res = Dialogs.ok) & (o # NIL) THEN Texts.Delete (t, t.len - 1, t.len) END
- END Do;
- PROCEDURE Track (f: DialogFrames.Frame; keys: SET; x0, y0: INTEGER; o: Dialogs.Object);
- VAR
- keys0, keysum: SET; new: Dialogs.Object; ch1, ch2, ch3: BOOLEAN;
- x, y, xh, yh, wh, hh, xdif, ydif, col, ox, oy, ow, oh: INTEGER; ch: CHAR;
- gfmsg: DialogFrames.GetFrameMsg; v: Viewers.Viewer; t: Texts.Text; r: Texts.Reader;
- BEGIN
- col := Display.white; keys0 := keys; keysum := keys;
- ch1 := FALSE; ch2 := FALSE; ch3 := FALSE;
- xdif := x0; ydif := y0;
- IF o # NIL THEN o.GetDim (xh, yh, wh, hh) ELSE xh := x0; yh := y0 END;
- IF (keys0 = {MR}) & (o # NIL) THEN
- IF o.selected THEN o.UnSelect ELSE o.Select END
- END;
- REPEAT
- Input.Mouse (keys, x, y); keysum := keysum + keys;
- xdif := xdif DIV f.grid * f.grid; ydif := ydif DIV f.grid * f.grid;
- x := x DIV f.grid * f.grid; y := y DIV f.grid * f.grid;
- Oberon.DrawCursor (Oberon.Mouse, Oberon.Arrow, x, y);
- IF (xdif # x) OR (ydif # y) THEN
- IF (keys0 = {MM}) THEN
- IF (keysum = {MM}) THEN
- IF (o # NIL) & (~ o.selected OR (o.panel.NofSelObjects () <= 1)) THEN
- o.GetDim (ox, oy, ow, oh);
- o.SetDim (ox - xdif + x, oy - ydif + y, ow, oh, FALSE);
- IF Dialogs.res = Dialogs.ok THEN ch1 := TRUE; xdif := x; ydif := y END
- ELSE
- f.panel.MoveSelected (x - xdif, y - ydif);
- IF Dialogs.res = Dialogs.ok THEN ch3 := TRUE; xdif := x; ydif := y; xh := x0; yh := y0 END
- END
- ELSIF (keysum = {MM, ML}) & (o # NIL) & ~ch3 THEN
- o.GetDim (ox, oy, ow, oh);
- o.SetDim (ox, oy, ow - xdif + x, oh - ydif + y, FALSE);
- IF Dialogs.res = Dialogs.ok THEN xdif := x; ydif := y; ch2 := TRUE END
- END;
- ELSIF (keys0 = {MR}) & (o = NIL) THEN
- Display1.Line (f, col, x0, y0, x0, ydif, Display.invert); Display1.Line (f, col, x0, y0, xdif, y0, Display.invert);
- Display1.Line (f, col, x0, ydif, xdif, ydif, Display.invert); Display1.Line (f, col, xdif, y0, xdif, ydif, Display.invert);
- xdif := x; ydif := y;
- f.panel.Select (Min (x0 - f.X, xdif - f.X), Min (y0 - f.Y - f.H, ydif - f.Y - f.H), ABS (x0 - xdif), ABS (y0 - ydif));
- Display1.Line (f, col, x0, y0, x0, ydif, Display.invert); Display1.Line (f, col, x0, y0, xdif, y0, Display.invert);
- Display1.Line (f, col, x0, ydif, xdif, ydif, Display.invert); Display1.Line (f, col, xdif, y0, xdif, ydif, Display.invert);
- END;
- END;
- UNTIL keys = {};
- IF (keys0 = {ML}) & (keysum = {ML}) THEN
- Oberon.DrawCursor (Oberon.Mouse, Oberon.Arrow, x, y);
- Oberon.DrawCursor (Oberon.Pointer, reticule, x, y);
- Oberon.PassFocus (Viewers.This (x, y));
- ELSIF (keys0 = {ML}) & (keysum = {ML, MM}) THEN
- X0 := MAX (INTEGER); X1 := MIN (INTEGER); Y0:= MAX (INTEGER); Y1 := MIN (INTEGER);
- f.panel.Enumerate (box);
- nx := (x - f.X) - X0; ny := (y - f.Y - f.H) + Y0; f.panel.Enumerate (EnumCopy)
- ELSIF (keys0 = {MR}) & (keysum = {ML, MR}) & (o # NIL) THEN
- f.panel.Remove (o); f.panel.RemoveSelections
- ELSIF (keys0 = {MR}) & (keysum = {MM, MR}) & (o # NIL) THEN
- o.UnSelect (); new := NIL; o.Copy (new);
- o.GetDim (ox, oy, ow, oh); new.SetName (""); new.SetDim (ox - x0 + x, oy - y0 + y, ow, oh, FALSE);
- f.panel.Insert (new, new.overlapping)
- ELSIF (keys0 = {MR}) & (o=NIL) THEN
- Display1.Line (f, col, x0, y0, x0, ydif, Display.invert); Display1.Line (f, col, x0, y0, xdif, y0, Display.invert);
- Display1.Line (f, col, x0, ydif, xdif, ydif, Display.invert); Display1.Line (f, col, xdif, y0, xdif, ydif, Display.invert);
- IF keysum = {MR, ML} THEN
- f.panel.RemoveObjects (Min (x0 - f.X, xdif - f.X), Min (y0 - f.Y - f.H, ydif - f.Y - f.H), ABS (x0 - xdif), ABS (y0 - ydif));
- END
- ELSIF (keys0 = {MM}) & (keysum = {MM, MR}) & (o # NIL) THEN
- IF ch1 THEN
- o.GetDim (ox, oy, ow, oh); o.SetDim (xh, yh, ow, oh, FALSE); (* set back to original position *)
- ELSIF ch3 THEN
- f.panel.MoveSelected (xh - xdif, yh - ydif)
- END;
- ch1 := FALSE; ch3 := FALSE; editObjectX := x; editObjectY := y; o.Edit ();
- (* removing of ! caused by changing the contents of text items *)
- gfmsg.p := Dialogs.editPanel; Viewers.Broadcast (gfmsg);
- IF gfmsg.f # NIL THEN
- v := Viewers.This (gfmsg.f.X, gfmsg.f.Y);
- IF (v # NIL) & (v IS MenuViewers.Viewer) & (v.dsc IS TextFrames.Frame) THEN
- t := v.dsc (TextFrames.Frame).text;
- Texts.OpenReader (r, t, t.len - 1); Texts.Read (r, ch);
- IF ch = "!" THEN Texts.Delete (t, t.len - 1, t.len) END
- END
- END
- END;
- IF (ch1) & (keysum # {MM}) & (keysum # {MM, ML}) & (o # NIL) THEN
- o.GetDim (ox, oy, ow, oh); o.SetDim (xh, yh, ow, oh, FALSE)
- END;
- IF (ch3) & (keysum # {MM}) & (keysum # {MM, ML}) THEN
- f.panel.MoveSelected (xh - xdif, yh - ydif)
- END;
- IF (ch2) & (keysum # {MM, ML}) & (o # NIL) THEN
- o.GetDim (xh, yh, ow, oh); o.SetDim (xh, yh, wh, hh, FALSE)
- END;
- END Track;
- PROCEDURE Handle* (f: Display.Frame; VAR msg: Display.FrameMsg);
- (** handles messages which were sent to the edit-frame f *)
- VAR self: DialogFrames.Frame; o: Dialogs.Object;
- BEGIN
- self := f (DialogFrames.Frame);
- WITH msg: Oberon.InputMsg DO
- IF msg.id = Oberon.consume THEN
- IF msg.ch = CRSL THEN self.panel.MoveSelected (- self.grid, 0)
- ELSIF msg.ch = CRSR THEN self.panel.MoveSelected (self.grid, 0)
- ELSIF msg.ch = CRSD THEN self.panel.MoveSelected (0, - self.grid)
- ELSIF msg.ch = CRSU THEN self.panel.MoveSelected (0, self.grid)
- END
- ELSIF (msg.id = Oberon.track) & (msg.keys # {}) THEN
- o := self.panel.ThisObject (msg.X - self.X, msg.Y - self.Y - f.H);
- Track (self, msg.keys, msg.X, msg.Y, o)
- ELSE
- DialogFrames.Handle (f, msg)
- END
- | msg: Oberon.ControlMsg DO
- IF (msg.id = Oberon.neutralize) THEN self.panel.RemoveSelections () END;
- DialogFrames.Handle (f, msg)
- ELSE
- DialogFrames.Handle (f, msg)
- END
- END Handle;
- PROCEDURE Edit*; (** name | ^ *)
- (** opens a dialog viewer and displays the dialog from file name for editing *)
- VAR name: ARRAY 32 OF CHAR; df: DialogFrames.Frame; v: Viewers.Viewer; x, y: INTEGER;
- panel: Dialogs.Panel; file: Files.File; r: Files.Rider; m: TextFrames.Frame; t: Texts.Text; buf: Texts.Buffer;
- BEGIN
- In.Open; In.Name(name); panel := NIL;
- IF In.Done THEN
- NEW(panel); file := Files.Old (name);
- IF file # NIL THEN Files.Set (r, file, 0); panel.Load (r) END
- END;
- IF panel # NIL THEN
- NEW(df); df.Open (Handle, panel); df.col := 11;
- Oberon.AllocateUserViewer (Oberon.Mouse.X, x, y);
- IF Files.Old ("Dialog.Menu.Text") = NIL THEN
- m := TextFrames.NewMenu (name, editMenu)
- ELSE
- m := TextFrames.NewMenu (name, "");
- NEW (t); Texts.Open (t, "Dialog.Menu.Text");
- NEW (buf); Texts.OpenBuf (buf); Texts.Save (t, 0, t.len, buf); Texts.Append (m.text, buf)
- END;
- v := MenuViewers.New (m, df, TextFrames.menuH, x, y)
- END
- END Edit;
- PROCEDURE Store*;
- (** stores the dialog under the name appearing in its menu frame *)
- VAR v: Viewers.Viewer; f: Files.File; r: Files.Rider; s: Texts.Scanner; name: ARRAY 64 OF CHAR;
- t: Texts.Text; r2: Texts.Reader; ch: CHAR;
- BEGIN
- v := Oberon.Par.vwr; name := "";
- IF (v.dsc # Oberon.Par.frame) OR (v.dsc = NIL) OR (v.dsc.next = NIL) OR ~(v.dsc.next IS DialogFrames.Frame) THEN
- v := Oberon.MarkedViewer ();
- Texts.OpenScanner (s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan (s);
- IF (s.line = 0) & ((s.class = Texts.Name) OR (s.class = Texts.String)) THEN COPY (s.s, name) END
- END;
- IF (v.dsc # NIL) & (v.dsc.next # NIL) & (v.dsc.next IS DialogFrames.Frame) THEN
- IF (name = "") & (v.dsc IS TextFrames.Frame) THEN
- Texts.OpenScanner (s, v.dsc(TextFrames.Frame).text, 0); Texts.Scan (s);
- IF (s.line = 0) & ((s.class = Texts.Name) OR (s.class = Texts.String)) THEN COPY (s.s, name) END
- END;
- IF name # "" THEN f := Files.New(name); Files.Set(r, f, 0);
- v.dsc.next(DialogFrames.Frame).panel.Store (r);
- Files.Register (f);
- Texts.WriteString (w0, "Dialog.Store ");
- Texts.WriteString (w0, name); Texts.WriteLn (w0);
- Texts.Append (Oberon.Log, w0.buf)
- END;
- t := v.dsc (TextFrames.Frame).text;
- Texts.OpenReader (r2, t, t.len - 1); Texts.Read (r2, ch);
- IF ch = "!" THEN Texts.Delete (t, t.len - 1, t.len) END
- END
- END Store;
- PROCEDURE Print*; (** ^ | * | {name} ~ *)
- (** prints dialogs to print server named server *)
- VAR s: Texts.Scanner; p: Dialogs.Panel; x, y, res: INTEGER;
- r: Files.Rider; file: Files.File; name: ARRAY 32 OF CHAR;
- PROCEDURE PrintGetMainArg (VAR s: Texts.Scanner);
- (* see implementation of module Edit *)
- VAR text: Texts.Text; beg, end, time: LONGINT;
- BEGIN
- Texts.Scan (s);
- IF (s.class = Texts.Char) & (s.c = "^") THEN
- Oberon.GetSelection (text, beg, end, time);
- IF time >= 0 THEN Texts.OpenScanner (s, text, beg); Texts.Scan (s) END
- END;
- IF s.line # 0 THEN s.class := Texts.Inval END
- END PrintGetMainArg;
- PROCEDURE PrintError (res: INTEGER);
- (* writes an error message to the log viewer *)
- BEGIN
- IF res = 1 THEN Texts.WriteString (w0, "Dialog Print Error 1: No connection")
- ELSIF res = 2 THEN Texts.WriteString (w0, "Dialog Print Error 2: No link")
- ELSIF res = 3 THEN Texts.WriteString (w0, "Dialog Print Error 3: Bad response")
- ELSIF res = 4 THEN Texts.WriteString (w0, "Dialog Print Error 4: Wrong input")
- ELSIF res = 5 THEN Texts.WriteString (w0, "Dialog Print Error 5: No panel selected")
- END;
- Texts.WriteLn (w0);
- Texts.Append (Oberon.Log, w0.buf)
- END PrintError;
- BEGIN
- Texts.OpenScanner (s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan (s);
- IF ((s.class = Texts.Name) OR (s.class = Texts.String)) & (s.line = 0) THEN
- COPY (s.s, name); PrintGetMainArg (s); res := 0;
- IF (s.class = Texts.Char) & (s.c = "*") THEN
- DialogFrames.GetCaretPosition (p, x, y);
- ELSIF s.class = Texts.Name THEN
- file := Files.Old (s.s);
- IF file # NIL THEN
- NEW (p); Files.Set (r, file, 0); p.Load (r);
- ELSE
- res := 4
- END
- ELSIF (Oberon.Par.vwr # NIL) & (Oberon.Par.vwr IS MenuViewers.Viewer) & (Oberon.Par.vwr.dsc.next IS DialogFrames.Frame) THEN
- p := Oberon.Par.vwr.dsc.next(DialogFrames.Frame).panel;
- ELSE
- res := 4
- END;
- IF (p # NIL) & (res = 0) THEN
- Printer.Open (name, Oberon.User, Oberon.Password); res := Printer.res;
- IF res = 0 THEN
- p.Print (0, Printer.PageHeight); Printer.Page (1); Printer.Close
- END
- ELSE
- IF res # 4 THEN res := 5 END
- END
- ELSE
- res :=4
- END;
- IF res # 0 THEN PrintError (res) END;
- END Print;
- PROCEDURE DrawReticule (x, y: INTEGER);
- BEGIN
- IF x < CL THEN
- IF x < markW THEN x := markW ELSIF x > DW THEN x := DW - markW END
- ELSE
- IF x < CL + markW THEN x := CL + markW ELSIF x > CL + DW THEN x := CL + DW - markW END
- END;
- IF y < markW THEN y := markW ELSIF y > DH THEN y := DH - markW END;
- Display.CopyPattern (Display.white, Display.cross, x - markW, y - markW, 2)
- END DrawReticule;
- BEGIN
- DW := Display.Width - 8; DH := Display.Height - 8; CL := Display.ColLeft;
- Texts.OpenWriter (w0); reticule.Draw := DrawReticule; reticule.Fade := DrawReticule;
- END Dialog.
-